perm filename SMP5.F4[P11,LCS] blob
sn#341680 filedate 1978-03-12 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C***** SMPLS.F4 (CALLED 'WAVES' AT IRCAM)**************
C00009 ENDMK
Cā;
C***** SMPLS.F4 (CALLED 'WAVES' AT IRCAM)**************
C DISPLAYS SAMPLE (WAVES) OF .SND FILES. LOAD WITH SMPLIN.FAI (WAVIN.FAI)
C GETFIL NOW TAKES 6-LETTER NAMES. EXTENSION .SND IS EXPECTED.
COMMON /JUNPAC/ JUNPAC
DIMENSION I(512),L(0/130),NNX(2)
C///// DIMENSION J(1024),I(3),L(0/130),NNX(2)
DOUBLE PRECISION NM,NMX,NMZ
EQUIVALENCE (I1,I),(I2,I(2)),(I3,I(3)),(AMP,MAXAMP)
1 ,(NNX,NM)
DATA NMX/' '/
DATA NMZ/' '/
IDEV=5
C***** 5=TTY, 1=DSK
LCNT=20
LEND=130
KOLD=130
JUNPAC=0
JNCX=0
KCNT=0
ICNT=0
TYPE 30
NNX(2)=' '
ACCEPT 31,NNX
IF(NM.EQ.NMZ)NM=NMX
4000 IF(NM.EQ.NMZ)NM='TEST'
NMX=NM
CALL IFILE(21,NM)
C///// CALL GETFIL(NM,M)
C**** M IS WD CNT.
C////3000 CALL FASTIN(J,128)
C////2000 ISR=J(2).AND."777777
C**** GET RIGHT HALF ONLY
C//// NCHNS=J(4)
C//// MAXAMP=J(5)
C//// IF(MAXAMP.GT.200000)MAXAMP=AMP
C*** WAS IT FLOATING PT.?
C//// JUNPAC=J(3).AND."777777
C//// IBIT=12
C//// KBIT=3
C//// IAMP=2080
C//// JAMP=51
C JAMP IS FACTOR TO TELL HOW MANY STARS = FULL AMPL.
C//// IF(JUNPAC.EQ.0)GO TO 32
C//// IBIT=18
C//// JAMP=3275
C//// KBIT=2
C//// IAMP=131000
C//// IF(MAXAMP.LT.2000)GO TO 32
C??? IF(MAXAMP.GT.500000)MAXAMP=AMP*131000
C//// IAMP=MAXAMP
C//// JAMP=IAMP/40
C***** 'NORMALIZES' LOW AMPL.
C////32 ISMPLS=(M-128)*KBIT
C//// DUR=NCHNS*ISR
C//// DUR=ISMPLS/DUR
C////1000 TYPE 43,ISMPLS,DUR,ISR,IBIT,NCHNS,MAXAMP
C////43 FORMAT
C//// 1(' FILE CONTAINS ',I7,' SAMPLES. DUR = ',F6.2,' SECS.'
C//// 1 ,/,' SRATE = ',I5,' BITS = ',
C//// 1 I2,', NCHNS = ',I1,', MAXAMP = ',I6)
C**** NEXT 2 FOR PDP11 VERSION (12BIT ONLY NOW)
IAMP=2080
JAMP=51
ISMPLS=32000
K40=40
IFLIP=0
NCH=1
IF(NCHNS.LT.2)GO TO 33
TYPE 34
34 FORMAT(' TYPE CHNL NUM. '$)
IFLIP=-1
ACCEPT 1,NCH
IF(NCH.EQ.0)NCH=1
IF(NCH.NE.1)IFLIP=-IFLIP
CC IF(IFLIP.GT.0)ICNT=-1
33 TYPE 47
ACCEPT 46,INCX
IF(INCX.EQ.0)INCX=1
TYPE 40
F=0
ACCEPT 46,ISKP,LAST,NORM
IF(LAST.EQ.0)LAST = ISKP+500
IF(LAST.LT.ISKP)LAST=ISKP+LAST
IF(LAST.GT.ISMPLS)LAST=ISMPLS
50 FORMAT(' <CR>=DPY F=TO A FILE '$)
51 FORMAT(' <CR>=LPT FORMAT D=DPY FORMAT '$)
TYPE 50
ACCEPT 31,IDSK
IF(IDSK.NE.'F')GO TO 45
TYPE 51
ACCEPT 31,F
CALL OFILE(1,'SMPLS')
IF(IDSK.NE.'F')GO TO 144
LCNT=50
TYPE 44
44 FORMAT(/' WRITING FILE: SMPLS.DAT',/,
1 ' TO STOP: TYPE <CALL>, F <CR>')
144 IDEV=1
C** FOR DSK OUTPUT.
40 FORMAT(' TYPE SAMPLE NUM.1, NUM2 '$)
1 FORMAT(8I9)
46 FORMAT(8I)
31 FORMAT(2A5)
30 FORMAT(' TYPE FILE NAME '$)
5 FORMAT(1X80A1)
CC JAMP=51
IF(JUNPAC.NE.0)JAMP=1637
45 IF(F.NE.' ')GO TO 102
JAMP=32
IF(JUNPAC.NE.0)JAMP=1007
K40=65
GO TO 2
CC102 CALL NODM
102 IF(JUNPAC.NE.0)GO TO 2
202 IF(MAXAMP.GT.1900)GO TO 2
C//// TYPE 103
C////103 FORMAT(' N=NORMALIZE '$)
C//// ACCEPT 31,K
C//// IF(K.NE.'N')GO TO 2
C//// IAMP=MAXAMP
C//// JAMP=IAMP/40
C////2 CALL FASTIN(J,1024)
C//// DO 3 K=1,1024
C//// CALL UNPAC(J(K),I)
2 READ(21)I
DO 3 JJ=1,512
C///// DO 3 JJ=1,KBIT
IFLIP=-IFLIP
ICNT=ICNT+1
IF(ICNT.LT.ISKP)GO TO 3
IF(ICNT.GT.LAST)GO TO 41
IF(IFLIP)GO TO 3
C****** STEREO FLIP-FLOP
JNCX=JNCX+1
IF(JNCX.NE.INCX)GO TO 3
JNCX=0
99 KX=I(JJ)
KK=(KX+IAMP)/JAMP
KF=-1
KZZ=6
CC IF(MOD(ICNT,100).NE.0)GO TO 997
KCNT=KCNT+1
IF(KCNT.LT.LCNT)GO TO 997
KCNT=0
KF=0
KZZ=14
997 IF(KOLD.EQ.KK)GO TO 777
K80=KOLD
IF(KK.GT.KOLD)K80=KK
IF(KK.GE.LEND)LEND=K40
DO 4 KM=6,LEND
4 L(KM)=' '
400 LEND=KK
INC=-1
IF(KK.GE.K40)INC=-INC
DO 999 KZ=K40,KK,INC
999 L(KZ)='*'
998 KZ=KK
KOLD=KK
IF (KZ.GE.K40)GO TO 777
KZ=K40
777 IF(KF)GO TO 7
WRITE(IDEV,106)NNX,ICNT,(L(NN),NN=15,KZ)
IF(IDEV.EQ.1)TYPE 106,NNX,ICNT
C***TELL HOW FAR ALONG WE ARE.
GO TO 3
7 IF(JUNPAC.NE.0)GO TO 778
WRITE(IDEV,1105)KX,(L(NN),NN=6,KZ)
GO TO 3
778 WRITE(IDEV,105)KX,(L(NN),NN=9,KZ)
3 CONTINUE
GO TO 2
CC41 CALL YESDM
41 STOP
47 FORMAT(' INCREMENT = '$)
105 FORMAT(I9,122A1)
1105 FORMAT(I6,124A1)
106 FORMAT(1XA5,A1,I8,116A1)
END